home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / windows / om / wfplus.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1992-04-08  |  4.6 KB  |  181 lines
  1. {WFPLUS - Function Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
  2. unit WFPlus;
  3. {************************  Interface       **********************}
  4. interface
  5. uses WinTypes, WinProcs, WinDos, Strings, WObjects,StdDlgs;
  6. const
  7.   sr_Recessed     =   1;
  8.   sr_Raised       =   0;
  9. function Max(I,J:Integer):Integer;
  10. function Min(I,J:Integer):Integer;
  11. function GetDateTime(szDateTime:PChar):Boolean;
  12. function ExpandTabs(InStr,OutStr:PChar;Tabsize:Integer):Boolean;
  13. function CheckCC(InStr,OutStr:PChar):Boolean;
  14. function SRectangle(PaintDC,X1,Y1,X2,Y2,LineWidth,State:Integer):Boolean;
  15. {************************  Implementation  ***************************}
  16. implementation
  17. {*************************  Max           ****************************}
  18. function Max(I,J:Integer):Integer;
  19. begin
  20.   if I > J then
  21.     Max := I
  22.   else
  23.     Max := J;
  24. end;
  25. {************************  Min            ****************************}
  26. function Min(I,J:Integer):Integer;
  27. begin
  28.   if I < J then
  29.     Min := I
  30.   else
  31.     Min := J;
  32. end;
  33.  
  34. function  GetDateTime(szDateTime:PChar):Boolean;
  35. var
  36.   m,d,y,dw: Word;
  37.   temp,tag: string[4];
  38.   tStr: String;
  39. Begin
  40.   tStr := '';
  41.   GetTime(y,m,d,dw);
  42.   if (y > 12) then begin
  43.     y := (y - 12);
  44.     tag := 'pm';
  45.   End else
  46.     tag := 'am';
  47.   str(y,temp);
  48.   if (y < 10) then
  49.     temp := '0' + Temp;
  50.   tStr := tStr + temp + ':';
  51.   str(m,Temp);
  52.   tStr := tStr + temp + ':';
  53.   str(d,temp);
  54.   tStr := tStr + temp + tag + '     ';
  55.   GetDate(y,m,d,dw);
  56.   str(m,Temp);
  57.   if (m < 10) then
  58.     temp := '0' + temp;
  59.   tStr := tStr + temp + '/';
  60.   str(d,Temp);
  61.   if (d < 10) then
  62.     Temp := '0' + temp;
  63.   tStr := tStr + Temp + '/';
  64.   str(y,temp);
  65.   tStr := tStr + temp;
  66.   strPcopy(szDateTime,tStr);
  67.   GetDateTime := True;
  68. End;
  69.  
  70. function ExpandTabs(InStr,OutStr:PChar;Tabsize:Integer):Boolean;
  71. var
  72.   IndxIn,IndxOut,IndxTab:Integer;
  73.    NextTab:Integer;
  74. begin
  75.   IndxIn := 0;IndxOut:= 0;IndxTab:= 0;
  76.   For IndxIn := 0 to (StrLen(InStr) -1) do
  77.     case InStr[IndxIn] of
  78.       #9:
  79.         begin
  80.         NextTab := ((IndxOut div TabSize) +1) * TabSize;
  81.         for IndxTab := 1 to (NextTab - IndxOut) do
  82.           begin
  83.           OutStr[IndxOut] := #32;
  84.           Inc(IndxOut);
  85.           end;
  86.         end;
  87.       #0..#31:
  88.         begin
  89.         OutStr[IndxOut] := #32;
  90.         Inc(IndxOut);
  91.         end;
  92.       else
  93.         begin
  94.         OutStr[IndxOut] := InStr[IndxIn];
  95.         Inc(IndxOut);
  96.         end;
  97.     end;
  98.   OutStr[IndxOut] := #0;
  99.   ExpandTabs := TRUE;
  100. end;
  101.  
  102. function CheckCC(InStr,OutStr:PChar):Boolean;
  103. var
  104.   IndxIn,IndxOut:Integer;
  105. begin
  106.   IndxIn := 0;IndxOut:= 0;
  107.   For IndxIn := 0 to (StrLen(InStr) -1) do
  108.     case InStr[IndxIn] of
  109.       #9:                             {retain tabs}
  110.         begin
  111.         OutStr[IndxOut] := #9;
  112.         Inc(IndxOut);
  113.         end;
  114.       #0..#31:
  115.         begin
  116.         OutStr[IndxOut] := #32;
  117.         Inc(IndxOut);
  118.         end;
  119.       else
  120.         begin
  121.         OutStr[IndxOut] := InStr[IndxIn];
  122.         Inc(IndxOut);
  123.         end;
  124.     end;
  125.   OutStr[IndxOut] := #0;
  126.   CheckCC := TRUE;
  127. end;
  128.  
  129. function SRectangle(PaintDC,X1,Y1,X2,Y2,LineWidth,State:Integer):Boolean;
  130. var
  131.   MemDC:HDc;
  132.   ThePen,Pen1,Pen2,OldPen:HPen;
  133.   TheBrush,OldBrush:HBrush;
  134.   OldBitMap:HBitMap;
  135.   LPts,RPts:Array[0..2] of TPoint;
  136.   X,Y,W,H:Integer;
  137.   PW,Ofs:Integer;
  138.   DBU:LongRec;
  139. begin
  140.   LongInt(DBU) := GetDialogBaseUnits;               
  141.   PW := Ofs;
  142.   Ofs := 1;            
  143.   TheBrush := GetStockObject(LtGray_Brush);
  144.   ThePen := CreatePen(ps_Solid,1,$00000000);
  145.   OldPen := SelectObject(PaintDC,ThePen);
  146.   OldBrush := SelectObject(PaintDC,TheBrush);
  147.   Rectangle(PaintDC,X1,Y1,X2,Y2);    {Draw gray box,black border}
  148.   SelectObject(PaintDC,OldBrush);
  149.   SelectObject(PaintDC,OldPen);
  150.   DeleteObject(ThePen);
  151.  
  152.   LPts[0].x := X1+Ofs; LPts[0].y := Y2-Ofs;
  153.   LPts[1].x := X1+Ofs; LPts[1].y := Y1-Ofs;
  154.   LPts[2].x := X2-Ofs; LPts[2].y := Y1-Ofs;
  155.   RPts[0].x := X1+Ofs; RPts[0].y := Y2-Ofs;
  156.   RPts[1].x := X2-Ofs; RPts[1].y := Y2-Ofs;
  157.   RPts[2].x := X2-Ofs; RPts[2].y := Y1-Ofs;
  158.   if State = sr_Raised then
  159.     begin
  160.     Pen1 := CreatePen(ps_Solid,LineWidth,$00FFFFFF);
  161.     Pen2 := CreatePen(ps_Solid,LineWidth,$00808080);
  162.     end
  163.   else
  164.     begin
  165.     Pen1 := CreatePen(ps_Solid,LineWidth,$00000000);
  166.     Pen2 := CreatePen(ps_Solid,LineWidth,$00FFFFFF);
  167.     end;
  168.  
  169.   OldPen := SelectObject(PaintDC,Pen1);   {Draw the highlights}
  170.   PolyLine(PaintDC,LPts,3);
  171.   SelectObject(PaintDC,Pen2);
  172.   DeleteObject(Pen1);
  173.  
  174.   PolyLine(PaintDC,RPts,3);
  175.   SelectObject(PaintDC,OldPen);
  176.   DeleteObject(Pen2);
  177.  
  178. end;
  179.  
  180. end.
  181.