12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240 |
- {
- $Id$
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2000 by Florian Klaempfl
- This file implements the win32 gui support for the graph unit
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit Graph;
- interface
- uses
- windows;
- {$i graphh.inc}
- var
- { this procedure allows to hook keyboard messages }
- charmessagehandler : WndProc;
- { this procedure allows to hook mouse messages }
- mousemessagehandler : WndProc;
- { this procedure allows to wm_command messages }
- commandmessagehandler : WndProc;
- NotifyMessageHandler : WndProc;
- OnGraphWindowCreation : procedure;
- GraphWindow,ParentWindow : HWnd;
- // this allows direct drawing to the window
- bitmapdc : hdc;
- windc : hdc;
- const
- { predefined window style }
- { we shouldn't set CS_DBLCLKS here }
- { because most dos applications }
- { handle double clicks on it's own }
- graphwindowstyle : DWord = cs_hRedraw or cs_vRedraw;
- windowtitle : pchar = 'Graph window application';
- menu : hmenu = 0;
- icon : hicon = 0;
- drawtoscreen : boolean = true;
- drawtobitmap : boolean = true;
- // the graph window can be a child window, this allows to add toolbars
- // to the main window
- UseChildWindow : boolean = false;
- // this allows to specify an offset for the child child window
- ChildOffset : rect = (left:0;top:0;right:0;bottom:0);
- CONST
- m640x200x16 = VGALo;
- m640x400x16 = VGAMed;
- m640x480x16 = VGAHi;
- { VESA Specific video modes. }
- m320x200x32k = $10D;
- m320x200x64k = $10E;
- m640x400x256 = $100;
- m640x480x256 = $101;
- m640x480x32k = $110;
- m640x480x64k = $111;
- m800x600x16 = $102;
- m800x600x256 = $103;
- m800x600x32k = $113;
- m800x600x64k = $114;
- m1024x768x16 = $104;
- m1024x768x256 = $105;
- m1024x768x32k = $116;
- m1024x768x64k = $117;
- m1280x1024x16 = $106;
- m1280x1024x256 = $107;
- m1280x1024x32k = $119;
- m1280x1024x64k = $11A;
- { some extra modes which applies only to GUI }
- mLargestWindow16 = $f0;
- mLargestWindow256 = $f1;
- mLargestWindow32k = $f2;
- mLargestWindow64k = $f3;
- mLargestWindow16M = $f4;
- mMaximizedWindow16 = $f5;
- mMaximizedWindow256 = $f6;
- mMaximizedWindow32k = $f7;
- mMaximizedWindow64k = $f8;
- mMaximizedWindow16M = $f9;
- implementation
- uses
- strings;
- {
- Remarks:
- Colors in 16 color mode:
- ------------------------
- - the behavior of xor/or/and put isn't 100%:
- it is done using the RGB color getting from windows
- instead of the palette index!
- - palette operations aren't supported
- To solve these drawbacks, setpalette must be implemented
- by exchanging the colors in the DCs, further GetPaletteEntry
- must be used when doing xor/or/and operations
- }
- const
- InternalDriverName = 'WIN32GUI';
- {$i graph.inc}
- { used to create a file containing all calls to WM_PAINT
- WARNING this probably creates HUGE files PM }
- { $define DEBUG_WM_PAINT}
- var
- savedscreen : hbitmap;
- graphrunning : boolean;
- graphdrawing : tcriticalsection;
- pens : array[0..15] of HPEN;
- {$ifdef DEBUG_WM_PAINT}
- graphdebug : text;
- const
- wm_paint_count : longint = 0;
- var
- {$endif DEBUG_WM_PAINT}
- oldbitmap : hgdiobj;
- pal : ^rgbrec;
- // SavePtr : pointer; { we don't use that pointer }
- MessageThreadHandle : Handle;
- MessageThreadID : DWord;
- function GetPaletteEntry(r,g,b : word) : word;
- var
- dist,i,index,currentdist : longint;
- begin
- dist:=$7fffffff;
- index:=0;
- for i:=0 to maxcolors do
- begin
- currentdist:=abs(r-pal[i].red)+abs(g-pal[i].green)+
- abs(b-pal[i].blue);
- if currentdist<dist then
- begin
- index:=i;
- dist:=currentdist;
- if dist=0 then
- break;
- end;
- end;
- GetPaletteEntry:=index;
- end;
- procedure PutPixel16Win32GUI(x,y : integer;pixel : word);
- var
- c : colorref;
- begin
- x:=x+startxviewport;
- y:=y+startyviewport;
- { convert to absolute coordinates and then verify clipping...}
- if clippixels then
- begin
- if (x<startxviewport) or (x>(startxviewport+viewwidth)) or
- (y<StartyViewPort) or (y>(startyviewport+viewheight)) then
- exit;
- end;
- if graphrunning then
- begin
- c:=RGB(pal[pixel].red,pal[pixel].green,pal[pixel].blue);
- EnterCriticalSection(graphdrawing);
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- LeaveCriticalSection(graphdrawing);
- end;
- end;
- function GetPixel16Win32GUI(x,y : integer) : word;
- var
- c : COLORREF;
- begin
- x:=x+startxviewport;
- y:=y+startyviewport;
- { convert to absolute coordinates and then verify clipping...}
- if clippixels then
- begin
- if (x<startxviewport) or (x>(startxviewport+viewwidth)) or
- (y<StartyViewPort) or (y>(startyviewport+viewheight)) then
- exit;
- end;
- if graphrunning then
- begin
- EnterCriticalSection(graphdrawing);
- c:=Windows.GetPixel(bitmapdc,x,y);
- LeaveCriticalSection(graphdrawing);
- GetPixel16Win32GUI:=GetPaletteEntry(GetRValue(c),GetGValue(c),GetBValue(c));
- end
- else
- begin
- _graphresult:=grerror;
- exit;
- end;
- end;
- procedure DirectPutPixel16Win32GUI(x,y : integer);
- var
- col : longint;
- c,c2 : COLORREF;
- begin
- if graphrunning then
- begin
- EnterCriticalSection(graphdrawing);
- col:=CurrentColor;
- case currentwritemode of
- XorPut:
- Begin
- c2:=Windows.GetPixel(windc,x,y);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2;
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- End;
- AndPut:
- Begin
- c2:=Windows.GetPixel(windc,x,y);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2;
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- End;
- OrPut:
- Begin
- c2:=Windows.GetPixel(windc,x,y);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2;
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- End
- else
- Begin
- If CurrentWriteMode<>NotPut Then
- col:=CurrentColor
- Else col := Not(CurrentColor);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- End
- end;
- LeaveCriticalSection(graphdrawing);
- end;
- end;
- var
- bitmapfontverticalcache : array[0..255] of HBITMAP;
- bitmapfonthorizoncache : array[0..255] of HBITMAP;
- procedure OutTextXYWin32GUI(x,y : smallint;const TextString : string);
- type
- Tpoint = record
- X,Y: smallint;
- end;
- var
- i,j,k,c : longint;
- xpos,ypos : longint;
- counter : longint;
- cnt1,cnt2 : smallint;
- cnt3,cnt4 : smallint;
- charsize : word;
- WriteMode : word;
- curX2, curY2, xpos2, ypos2, x2, y2: graph_float;
- oldvalues : linesettingstype;
- fontbitmap : TBitmapChar;
- chr : char;
- curx2i,cury2i,
- xpos2i,ypos2i : longint;
- charbitmap,oldcharbitmap : HBITMAP;
- chardc : HDC;
- color : longint;
- brushwin,oldbrushwin,brushbitmap,oldbrushbitmap : HBRUSH;
- bitmaprgn,winrgn : HRGN;
- begin
- { save current write mode }
- WriteMode := CurrentWriteMode;
- CurrentWriteMode := NormalPut;
- GetTextPosition(xpos,ypos,textstring);
- X:=X-XPos; Y:=Y+YPos;
- XPos:=X; YPos:=Y;
- CharSize := CurrentTextInfo.Charsize;
- if Currenttextinfo.font=DefaultFont then
- begin
- if CurrentTextInfo.direction=HorizDir then
- { Horizontal direction }
- begin
- if (x>viewwidth) or (y>viewheight) or
- (x<0) or (y<0) then
- begin
- CurrentWriteMode:=WriteMode;
- exit;
- end;
- EnterCriticalSection(graphdrawing);
- c:=length(textstring);
- chardc:=CreateCompatibleDC(windc);
- if currentcolor<>white then
- begin
- color:=RGB(pal[currentcolor].red,pal[currentcolor].green,
- pal[currentcolor].blue);
- if drawtoscreen then
- begin
- brushwin:=CreateSolidBrush(color);
- oldbrushwin:=SelectObject(windc,brushwin);
- end;
- if drawtobitmap then
- begin
- brushbitmap:=CreateSolidBrush(color);
- oldbrushbitmap:=SelectObject(bitmapdc,brushbitmap);
- end;
- end;
- inc(x,startxviewport);
- inc(y,startyviewport);
- { let windows do the clipping }
- if drawtobitmap then
- begin
- bitmaprgn:=CreateRectRgn(startxviewport,startyviewport,
- startxviewport+viewwidth+1,startyviewport+viewheight+1);
- SelectClipRgn(bitmapdc,bitmaprgn);
- end;
- if drawtoscreen then
- begin
- winrgn:=CreateRectRgn(startxviewport,startyviewport,
- startxviewport+viewwidth+1,startyviewport+viewheight+1);
- SelectClipRgn(windc,winrgn);
- end;
- for i:=0 to c-1 do
- begin
- xpos:=x+(i*8)*Charsize;
- if bitmapfonthorizoncache[byte(textstring[i+1])]=0 then
- begin
- charbitmap:=CreateCompatibleBitmap(windc,8,8);
- if charbitmap=0 then
- writeln('Bitmap konnte nicht erzeugt werden!');
- oldcharbitmap:=SelectObject(chardc,charbitmap);
- Fontbitmap:=TBitmapChar(DefaultFontData[textstring[i+1]]);
- for j:=0 to 7 do
- for k:=0 to 7 do
- if Fontbitmap[j,k]<>0 then
- SetPixelV(chardc,k,j,$ffffff)
- else
- SetPixelV(chardc,k,j,0);
- bitmapfonthorizoncache[byte(textstring[i+1])]:=charbitmap;
- SelectObject(chardc,oldcharbitmap);
- end;
- oldcharbitmap:=SelectObject(chardc,bitmapfonthorizoncache[byte(textstring[i+1])]);
- if CharSize=1 then
- begin
- if currentcolor=white then
- begin
- if drawtoscreen then
- BitBlt(windc,xpos,y,8,8,chardc,0,0,SRCPAINT);
- if drawtobitmap then
- BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,SRCPAINT);
- end
- else
- begin
- { could we do this with one pattern operation ?? }
- { we would need something like DSnaSPao }
- if drawtoscreen then
- begin
- // ROP $00220326=DSna
- BitBlt(windc,xpos,y,8,8,chardc,0,0,$00220326);
- // ROP $00EA02E9 = DPSao
- BitBlt(windc,xpos,y,8,8,chardc,0,0,$00EA02E9);
- end;
- if drawtobitmap then
- begin
- BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,$00220326);
- BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,$00EA02E9);
- end;
- end;
- end
- else
- begin
- if currentcolor=white then
- begin
- if drawtoscreen then
- StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
- if drawtobitmap then
- StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
- end
- else
- begin
- { could we do this with one pattern operation ?? }
- { we would need something like DSnaSPao }
- if drawtoscreen then
- begin
- // ROP $00220326=DSna
- StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
- // ROP $00EA02E9 = DPSao
- StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
- end;
- if drawtobitmap then
- begin
- StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
- StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
- end;
- end;
- end;
- SelectObject(chardc,oldcharbitmap);
- end;
- if currentcolor<>white then
- begin
- if drawtoscreen then
- begin
- SelectObject(windc,oldbrushwin);
- DeleteObject(brushwin);
- end;
- if drawtobitmap then
- begin
- SelectObject(bitmapdc,oldbrushbitmap);
- DeleteObject(brushbitmap);
- end;
- end;
- { release clip regions }
- if drawtobitmap then
- begin
- SelectClipRgn(bitmapdc,0);
- DeleteObject(bitmaprgn);
- end;
- if drawtoscreen then
- begin
- SelectClipRgn(windc,0);
- DeleteObject(winrgn);
- end;
- DeleteDC(chardc);
- LeaveCriticalSection(graphdrawing);
- end
- else
- { Vertical direction }
- begin
- if (x>viewwidth) or (y>viewheight) or
- (x<0) or (y<0) then
- begin
- CurrentWriteMode:=WriteMode;
- exit;
- end;
- EnterCriticalSection(graphdrawing);
- c:=length(textstring);
- chardc:=CreateCompatibleDC(windc);
- if currentcolor<>white then
- begin
- color:=RGB(pal[currentcolor].red,pal[currentcolor].green,
- pal[currentcolor].blue);
- if drawtoscreen then
- begin
- brushwin:=CreateSolidBrush(color);
- oldbrushwin:=SelectObject(windc,brushwin);
- end;
- if drawtobitmap then
- begin
- brushbitmap:=CreateSolidBrush(color);
- oldbrushbitmap:=SelectObject(bitmapdc,brushbitmap);
- end;
- end;
- inc(x,startxviewport);
- inc(y,startyviewport);
- { let windows do the clipping }
- if drawtoscreen then
- begin
- winrgn:=CreateRectRgn(startxviewport,startyviewport,
- startxviewport+viewwidth+1,startyviewport+viewheight+1);
- SelectClipRgn(windc,winrgn);
- end;
- if drawtobitmap then
- begin
- bitmaprgn:=CreateRectRgn(startxviewport,startyviewport,
- startxviewport+viewwidth+1,startyviewport+viewheight+1);
- SelectClipRgn(bitmapdc,bitmaprgn);
- end;
- for i:=0 to c-1 do
- begin
- ypos:=y+1-((i+1)*8)*CharSize;
- if bitmapfontverticalcache[byte(textstring[i+1])]=0 then
- begin
- charbitmap:=CreateCompatibleBitmap(windc,8,8);
- if charbitmap=0 then
- writeln('Bitmap konnte nicht erzeugt werden!');
- oldcharbitmap:=SelectObject(chardc,charbitmap);
- Fontbitmap:=TBitmapChar(DefaultFontData[textstring[i+1]]);
- for j:=0 to 7 do
- for k:=0 to 7 do
- if Fontbitmap[j,k]<>0 then
- SetPixelV(chardc,j,7-k,$ffffff)
- else
- SetPixelV(chardc,j,7-k,0);
- bitmapfontverticalcache[byte(textstring[i+1])]:=charbitmap;
- SelectObject(chardc,oldcharbitmap);
- end;
- oldcharbitmap:=SelectObject(chardc,bitmapfontverticalcache[byte(textstring[i+1])]);
- if CharSize=1 then
- begin
- if currentcolor=white then
- begin
- if drawtoscreen then
- BitBlt(windc,x,ypos,8,8,chardc,0,0,SRCPAINT);
- if drawtobitmap then
- BitBlt(bitmapdc,x,ypos,8,8,chardc,0,0,SRCPAINT);
- end
- else
- begin
- { could we do this with one pattern operation ?? }
- { we would need something like DSnaSPao }
- if drawtoscreen then
- begin
- // ROP $00220326=DSna
- BitBlt(windc,x,ypos,8,8,chardc,0,0,$00220326);
- // ROP $00EA02E9 = DPSao
- BitBlt(windc,x,ypos,8,8,chardc,0,0,$00EA02E9);
- end;
- if drawtobitmap then
- begin
- BitBlt(bitmapdc,x,ypos,8,8,chardc,0,0,$00220326);
- BitBlt(bitmapdc,x,ypos,8,8,chardc,0,0,$00EA02E9);
- end;
- end;
- end
- else
- begin
- if currentcolor=white then
- begin
- if drawtoscreen then
- StretchBlt(windc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
- if drawtobitmap then
- StretchBlt(bitmapdc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
- end
- else
- begin
- { could we do this with one pattern operation ?? }
- { we would need something like DSnaSPao }
- if drawtoscreen then
- begin
- // ROP $00220326=DSna
- StretchBlt(windc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
- // ROP $00EA02E9 = DPSao
- StretchBlt(windc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
- end;
- if drawtobitmap then
- begin
- StretchBlt(bitmapdc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
- StretchBlt(bitmapdc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
- end;
- end;
- end;
- SelectObject(chardc,oldcharbitmap);
- end;
- if currentcolor<>white then
- begin
- if drawtoscreen then
- begin
- SelectObject(windc,oldbrushwin);
- DeleteObject(brushwin);
- end;
- if drawtobitmap then
- begin
- SelectObject(bitmapdc,oldbrushbitmap);
- DeleteObject(brushbitmap);
- end;
- end;
- { release clip regions }
- if drawtoscreen then
- begin
- SelectClipRgn(windc,0);
- DeleteObject(winrgn);
- end;
- if drawtobitmap then
- begin
- SelectClipRgn(bitmapdc,0);
- DeleteObject(bitmaprgn);
- end;
- DeleteDC(chardc);
- LeaveCriticalSection(graphdrawing);
- end;
- end else
- { This is a stroked font which is already loaded into memory }
- begin
- getlinesettings(oldvalues);
- { reset line style to defaults }
- setlinestyle(solidln,oldvalues.pattern,normwidth);
- if Currenttextinfo.direction=vertdir then
- xpos:=xpos + Textheight(textstring);
- CurX2:=xpos; xpos2 := curX2; x2 := xpos2;
- CurY2:=ypos; ypos2 := curY2; y2 := ypos2;
- { x:=xpos; y:=ypos;}
- for i:=1 to length(textstring) do
- begin
- c:=byte(textstring[i]);
- { Stroke_Count[c] := }
- unpack( fonts[CurrentTextInfo.font].instr,
- fonts[CurrentTextInfo.font].Offsets[c], Strokes );
- counter:=0;
- while true do
- begin
- if CurrentTextInfo.direction=VertDir then
- begin
- xpos2:=x2-(Strokes[counter].Y*CurrentYRatio);
- ypos2:=y2-(Strokes[counter].X*CurrentXRatio);
- end
- else
- begin
- xpos2:=x2+(Strokes[counter].X*CurrentXRatio) ;
- ypos2:=y2-(Strokes[counter].Y*CurrentYRatio) ;
- end;
- case opcodes(Strokes[counter].opcode) of
- _END_OF_CHAR: break;
- _DO_SCAN: begin
- { Currently unsupported };
- end;
- _MOVE : Begin
- CurX2 := XPos2;
- CurY2 := YPos2;
- end;
- _DRAW: Begin
- curx2i:=trunc(CurX2);
- cury2i:=trunc(CurY2);
- xpos2i:=trunc(xpos2);
- ypos2i:=trunc(ypos2);
- { this optimization doesn't matter that much
- if (curx2i=xpos2i) then
- begin
- if (cury2i=ypos2i) then
- putpixel(curx2i,cury2i,currentcolor)
- else if (cury2i+1=ypos2i) or
- (cury2i=ypos2i+1) then
- begin
- putpixel(curx2i,cury2i,currentcolor);
- putpixel(curx2i,ypos2i,currentcolor);
- end
- else
- Line(curx2i,cury2i,xpos2i,ypos2i);
- end
- else if (cury2i=ypos2i) then
- begin
- if (curx2i+1=xpos2i) or
- (curx2i=xpos2i+1) then
- begin
- putpixel(curx2i,cury2i,currentcolor);
- putpixel(xpos2i,cury2i,currentcolor);
- end
- else
- Line(curx2i,cury2i,xpos2i,ypos2i);
- end
- else
- }
- Line(curx2i,cury2i,xpos2i,ypos2i);
- CurX2:=xpos2;
- CurY2:=ypos2;
- end;
- else
- Begin
- end;
- end;
- Inc(counter);
- end; { end while }
- if Currenttextinfo.direction=VertDir then
- y2:=y2-(byte(fonts[CurrenttextInfo.font].widths[c])*CurrentXRatio)
- else
- x2:=x2+(byte(fonts[Currenttextinfo.font].widths[c])*CurrentXRatio);
- end;
- setlinestyle( oldvalues.linestyle, oldvalues.pattern, oldvalues.thickness);
- end;
- { restore write mode }
- CurrentWriteMode := WriteMode;
- end;
- procedure HLine16Win32GUI(x,x2,y: integer);
- var
- c,c2 : COLORREF;
- col,i : longint;
- oldpen,pen : HPEN;
- Begin
- if graphrunning then
- begin
- { must we swap the values? }
- if x>x2 then
- Begin
- x:=x xor x2;
- x2:=x xor x2;
- x:=x xor x2;
- end;
- if ClipPixels then
- begin
- if (x>ViewWidth) or (y<0) or (y>ViewHeight) or (x2<0) then
- exit;
- if x<0 then
- x:=0;
- if x2>ViewWidth then
- x2:=ViewWidth;
- end;
- X:=X+StartXViewPort;
- X2:=X2+StartXViewPort;
- Y:=Y+StartYViewPort;
- Case CurrentWriteMode of
- AndPut:
- Begin
- EnterCriticalSection(graphdrawing);
- col:=CurrentColor;
- for i:=x to x2 do
- begin
- c2:=Windows.GetPixel(windc,i,y);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2;
- if drawtobitmap then
- SetPixelV(bitmapdc,i,y,c);
- if drawtoscreen then
- SetPixelV(windc,i,y,c);
- end;
- LeaveCriticalSection(graphdrawing);
- End;
- XorPut:
- Begin
- EnterCriticalSection(graphdrawing);
- col:=CurrentColor;
- for i:=x to x2 do
- begin
- c2:=Windows.GetPixel(windc,i,y);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2;
- if drawtobitmap then
- SetPixelV(bitmapdc,i,y,c);
- if drawtoscreen then
- SetPixelV(windc,i,y,c);
- end;
- LeaveCriticalSection(graphdrawing);
- End;
- OrPut:
- Begin
- EnterCriticalSection(graphdrawing);
- col:=CurrentColor;
- for i:=x to x2 do
- begin
- c2:=Windows.GetPixel(windc,i,y);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2;
- if drawtobitmap then
- SetPixelV(bitmapdc,i,y,c);
- if drawtoscreen then
- SetPixelV(windc,i,y,c);
- end;
- LeaveCriticalSection(graphdrawing);
- End
- Else
- Begin
- If CurrentWriteMode<>NotPut Then
- col:=CurrentColor
- Else col:=Not(CurrentColor);
- EnterCriticalSection(graphdrawing);
- if x2-x<=2 then
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- for x := x to x2 do
- begin
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- end;
- end
- else
- begin
- if (col>=0) and (col<=high(pens)) then
- begin
- if pens[col]=0 then
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- pens[col]:=CreatePen(PS_SOLID,1,c);
- end;
- pen:=pens[col];
- end
- else
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- pen:=CreatePen(PS_SOLID,1,c);
- end;
- if drawtobitmap then
- begin
- oldpen:=SelectObject(bitmapdc,pen);
- Windows.MoveToEx(bitmapdc,x,y,nil);
- Windows.LineTo(bitmapdc,x2+1,y);
- SelectObject(bitmapdc,oldpen);
- end;
- if drawtoscreen then
- begin
- oldpen:=SelectObject(windc,pen);
- Windows.MoveToEx(windc,x,y,nil);
- Windows.LineTo(windc,x2+1,y);
- SelectObject(windc,oldpen);
- end;
- if (col<0) or (col>high(pens)) then
- DeleteObject(pen);
- end;
- LeaveCriticalSection(graphdrawing);
- End;
- End;
- end;
- end;
- procedure VLine16Win32GUI(x,y,y2: smallint); {$ifndef fpc}far;{$endif fpc}
- var
- ytmp: smallint;
- col,c : longint;
- oldpen,pen : HPEN;
- Begin
- { must we swap the values? }
- if y >= y2 then
- Begin
- ytmp := y2;
- y2 := y;
- y:= ytmp;
- end;
- if ClipPixels then
- begin
- if (x>ViewWidth) or (x<0) or (y>ViewHeight) or (y2<0) then
- exit;
- if y<0 then
- y:=0;
- if y2>ViewHeight then
- y2:=ViewHeight;
- end;
- { First convert to global coordinates }
- X := X + StartXViewPort;
- Y2 := Y2 + StartYViewPort;
- Y := Y + StartYViewPort;
- if currentwritemode=normalput then
- begin
- col:=CurrentColor;
- EnterCriticalSection(graphdrawing);
- if y2-y<=2 then
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- for y := y to y2 do
- begin
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- end;
- end
- else
- begin
- if (col>=0) and (col<=high(pens)) then
- begin
- if pens[col]=0 then
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- pens[col]:=CreatePen(PS_SOLID,1,c);
- end;
- pen:=pens[col];
- end
- else
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- pen:=CreatePen(PS_SOLID,1,c);
- end;
- if drawtobitmap then
- begin
- oldpen:=SelectObject(bitmapdc,pen);
- Windows.MoveToEx(bitmapdc,x,y,nil);
- Windows.LineTo(bitmapdc,x,y2+1);
- SelectObject(bitmapdc,oldpen);
- end;
- if drawtoscreen then
- begin
- oldpen:=SelectObject(windc,pen);
- Windows.MoveToEx(windc,x,y,nil);
- Windows.LineTo(windc,x,y2+1);
- SelectObject(windc,oldpen);
- end;
- if (col<0) or (col>high(pens)) then
- DeleteObject(pen);
- end;
- LeaveCriticalSection(graphdrawing);
- end
- else
- for y := y to y2 do Directputpixel(x,y)
- End;
- procedure Circle16Win32GUI(X, Y: smallint; Radius:Word);
- var
- bitmaprgn,winrgn : HRGN;
- col,c : longint;
- oldpen,pen : HPEN;
- OriginalArcInfo: ArcCoordsType;
- OldWriteMode: word;
- begin
- if (Radius = 0) then
- Exit;
- if (Radius = 1) then
- begin
- { only normal put mode is supported by a call to PutPixel }
- PutPixel(X, Y, CurrentColor);
- Exit;
- end;
- if (Radius = 2) then
- begin
- { only normal put mode is supported by a call to PutPixel }
- PutPixel(X-1, Y, CurrentColor);
- PutPixel(X+1, Y, CurrentColor);
- PutPixel(X, Y-1, CurrentColor);
- PutPixel(X, Y+1, CurrentColor);
- Exit;
- end;
- if LineInfo.Thickness = Normwidth then
- begin
- EnterCriticalSection(graphdrawing);
- { let windows do the clipping }
- if drawtobitmap then
- begin
- bitmaprgn:=CreateRectRgn(startxviewport,startyviewport,
- startxviewport+viewwidth+1,startyviewport+viewheight+1);
- SelectClipRgn(bitmapdc,bitmaprgn);
- end;
- if drawtoscreen then
- begin
- winrgn:=CreateRectRgn(startxviewport,startyviewport,
- startxviewport+viewwidth+1,startyviewport+viewheight+1);
- SelectClipRgn(windc,winrgn);
- end;
- inc(x,StartXViewPort);
- inc(y,StartYViewPort);
- col:=CurrentColor;
- if (col>=0) and (col<=high(pens)) then
- begin
- if pens[col]=0 then
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- pens[col]:=CreatePen(PS_SOLID,1,c);
- end;
- pen:=pens[col];
- end
- else
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- pen:=CreatePen(PS_SOLID,1,c);
- end;
- if drawtobitmap then
- begin
- oldpen:=SelectObject(bitmapdc,pen);
- windows.arc(bitmapdc,x-radius,y-radius,x+radius,y+radius,
- x,y-radius,x,y-radius);
- SelectObject(bitmapdc,oldpen);
- end;
- if drawtoscreen then
- begin
- oldpen:=SelectObject(windc,pen);
- windows.arc(windc,x-radius,y-radius,x+radius,y+radius,
- x,y-radius,x,y-radius);
- SelectObject(windc,oldpen);
- end;
- if (col<0) or (col>high(pens)) then
- DeleteObject(pen);
- { release clip regions }
- if drawtoscreen then
- begin
- SelectClipRgn(windc,0);
- DeleteObject(winrgn);
- end;
- if drawtobitmap then
- begin
- SelectClipRgn(bitmapdc,0);
- DeleteObject(bitmaprgn);
- end;
- LeaveCriticalSection(graphdrawing);
- end
- else
- begin
- { save state of arc information }
- { because it is not needed for }
- { a circle call. }
- move(ArcCall,OriginalArcInfo, sizeof(ArcCall));
- InternalEllipse(X,Y,Radius,Radius,0,360,{$ifdef fpc}@{$endif}DummyPatternLine);
- { restore arc information }
- move(OriginalArcInfo, ArcCall,sizeof(ArcCall));
- end;
- end;
- {
- Procedure PutImageWin32GUI(X,Y: smallint; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc}
- type
- pt = array[0..$fffffff] of word;
- ptw = array[0..2] of longint;
- var
- k: longint;
- oldCurrentColor: word;
- oldCurrentWriteMode, i, j, y1, x1, deltaX, deltaX1, deltaY: smallint;
- Begin
- {$ifdef logging}
- LogLn('putImage at ('+strf(x)+','+strf(y)+') with width '+strf(ptw(Bitmap)[0])+
- ' and height '+strf(ptw(Bitmap)[1]));
- deltaY := 0;
- {$endif logging}
- inc(x,startXViewPort);
- inc(y,startYViewPort);
- x1 := ptw(Bitmap)[0]+x; { get width and adjust end coordinate accordingly }
- y1 := ptw(Bitmap)[1]+y; { get height and adjust end coordinate accordingly }
- deltaX := 0;
- deltaX1 := 0;
- k := 3 * sizeOf(Longint) div sizeOf(Word); { Three reserved longs at start of bitmap }
- { check which part of the image is in the viewport }
- if clipPixels then
- begin
- if y < startYViewPort then
- begin
- deltaY := startYViewPort - y;
- inc(k,(x1-x+1)*deltaY);
- y := startYViewPort;
- end;
- if y1 > startYViewPort+viewHeight then
- y1 := startYViewPort+viewHeight;
- if x < startXViewPort then
- begin
- deltaX := startXViewPort-x;
- x := startXViewPort;
- end;
- if x1 > startXViewPort + viewWidth then
- begin
- deltaX1 := x1 - (startXViewPort + viewWidth);
- x1 := startXViewPort + viewWidth;
- end;
- end;
- {$ifdef logging}
- LogLn('deltax: '+strf(deltax)+', deltax1: '+strf(deltax1)+',deltay: '+strf(deltay));
- {$endif logging}
- case bitBlt of
- end;
- oldCurrentColor := currentColor;
- oldCurrentWriteMode := currentWriteMode;
- currentWriteMode := bitBlt;
- for j:=Y to Y1 do
- Begin
- inc(k,deltaX);
- for i:=X to X1 do
- begin
- currentColor := pt(bitmap)[k];
- directPutPixel(i,j);
- inc(k);
- end;
- inc(k,deltaX1);
- end;
- currentWriteMode := oldCurrentWriteMode;
- currentColor := oldCurrentColor;
- end;
- }
- procedure SetRGBPaletteWin32GUI(colorNum,redValue,greenvalue,
- bluevalue : integer);
- begin
- if directcolor or (colornum<0) or (colornum>=maxcolor) then
- begin
- _graphresult:=grerror;
- exit;
- end;
- pal[colorNum].red:=redValue;
- pal[colorNum].green:=greenValue;
- pal[colorNum].blue:=blueValue;
- if (colorNum>=0) and (colorNum<=high(pens)) and (pens[colorNum]<>0) then
- begin
- DeleteObject(pens[colorNum]);
- pens[colorNum]:=0;
- end;
- end;
- procedure GetRGBPaletteWin32GUI(colorNum : integer;
- var redValue,greenvalue,bluevalue : integer);
- begin
- if directcolor or (colornum<0) or (colornum>=maxcolor) then
- begin
- _graphresult:=grerror;
- exit;
- end;
- redValue:=pal[colorNum].red;
- greenValue:=pal[colorNum].green;
- blueValue:=pal[colorNum].blue;
- end;
- procedure savestate;
- begin
- end;
- procedure restorestate;
- begin
- end;
- function WindowProcGraph(Window: HWnd; AMessage:UInt; WParam : WParam;
- LParam: LParam): Longint; stdcall;
- var
- dc : hdc;
- ps : paintstruct;
- r : rect;
- oldbrush : hbrush;
- oldpen : hpen;
- i : longint;
- begin
- WindowProcGraph := 0;
- case AMessage of
- wm_lbuttondown,
- wm_rbuttondown,
- wm_mbuttondown,
- wm_lbuttonup,
- wm_rbuttonup,
- wm_mbuttonup,
- wm_lbuttondblclk,
- wm_rbuttondblclk,
- wm_mbuttondblclk:
- {
- This leads to problem, i.e. the menu etc doesn't work any longer
- wm_nclbuttondown,
- wm_ncrbuttondown,
- wm_ncmbuttondown,
- wm_nclbuttonup,
- wm_ncrbuttonup,
- wm_ncmbuttonup,
- wm_nclbuttondblclk,
- wm_ncrbuttondblclk,
- wm_ncmbuttondblclk:
- }
- begin
- if assigned(mousemessagehandler) then
- WindowProcGraph:=mousemessagehandler(window,amessage,wparam,lparam);
- end;
- wm_notify:
- begin
- if assigned(notifymessagehandler) then
- WindowProcGraph:=notifymessagehandler(window,amessage,wparam,lparam);
- end;
- wm_command:
- if assigned(commandmessagehandler) then
- WindowProcGraph:=commandmessagehandler(window,amessage,wparam,lparam);
- wm_keydown,
- wm_keyup,
- wm_char:
- begin
- if assigned(charmessagehandler) then
- WindowProcGraph:=charmessagehandler(window,amessage,wparam,lparam);
- end;
- wm_paint:
- begin
- {$ifdef DEBUG_WM_PAINT}
- inc(wm_paint_count);
- {$endif DEBUG_WM_PAINT}
- {$ifdef DEBUGCHILDS}
- writeln('Start child painting');
- {$endif DEBUGCHILDS}
- if not GetUpdateRect(Window,@r,false) then
- exit;
- EnterCriticalSection(graphdrawing);
- graphrunning:=true;
- dc:=BeginPaint(Window,@ps);
- {$ifdef DEBUG_WM_PAINT}
- Writeln(graphdebug,'WM_PAINT in ((',r.left,',',r.top,
- '),(',r.right,',',r.bottom,'))');
- {$endif def DEBUG_WM_PAINT}
- if graphrunning then
- {BitBlt(dc,0,0,maxx+1,maxy+1,bitmapdc,0,0,SRCCOPY);}
- BitBlt(dc,r.left,r.top,r.right-r.left+1,r.bottom-r.top+1,bitmapdc,r.left,r.top,SRCCOPY);
- EndPaint(Window,ps);
- LeaveCriticalSection(graphdrawing);
- Exit;
- end;
- wm_create:
- begin
- {$ifdef DEBUG_WM_PAINT}
- assign(graphdebug,'wingraph.log');
- rewrite(graphdebug);
- {$endif DEBUG_WM_PAINT}
- {$ifdef DEBUGCHILDS}
- writeln('Creating window (HWND: ',window,')... ');
- {$endif DEBUGCHILDS}
- GraphWindow:=window;
- EnterCriticalSection(graphdrawing);
- dc:=GetDC(window);
- {$ifdef DEBUGCHILDS}
- writeln('Window DC: ',dc);
- {$endif DEBUGCHILDS}
- bitmapdc:=CreateCompatibleDC(dc);
- savedscreen:=CreateCompatibleBitmap(dc,maxx+1,maxy+1);
- ReleaseDC(window,dc);
- oldbitmap:=SelectObject(bitmapdc,savedscreen);
- windc:=GetDC(window);
- // clear everything
- oldpen:=SelectObject(bitmapdc,GetStockObject(BLACK_PEN));
- oldbrush:=SelectObject(bitmapdc,GetStockObject(BLACK_BRUSH));
- Windows.Rectangle(bitmapdc,0,0,maxx,maxy);
- SelectObject(bitmapdc,oldpen);
- SelectObject(bitmapdc,oldbrush);
- // ... the window too
- oldpen:=SelectObject(windc,GetStockObject(BLACK_PEN));
- oldbrush:=SelectObject(windc,GetStockObject(BLACK_BRUSH));
- Windows.Rectangle(windc,0,0,maxx,maxy);
- SelectObject(windc,oldpen);
- SelectObject(windc,oldbrush);
- // clear font cache
- fillchar(bitmapfonthorizoncache,sizeof(bitmapfonthorizoncache),0);
- fillchar(bitmapfontverticalcache,sizeof(bitmapfontverticalcache),0);
- // clear predefined pens
- fillchar(pens,sizeof(pens),0);
- if assigned(OnGraphWindowCreation) then
- OnGraphWindowCreation;
- LeaveCriticalSection(graphdrawing);
- {$ifdef DEBUGCHILDS}
- writeln('done');
- GetClientRect(window,@r);
- writeln('Window size: ',r.right,',',r.bottom);
- {$endif DEBUGCHILDS}
- end;
- wm_Destroy:
- begin
- EnterCriticalSection(graphdrawing);
- graphrunning:=false;
- ReleaseDC(GraphWindow,windc);
- SelectObject(bitmapdc,oldbitmap);
- DeleteObject(savedscreen);
- DeleteDC(bitmapdc);
- // release font cache
- for i:=0 to 255 do
- if bitmapfonthorizoncache[i]<>0 then
- DeleteObject(bitmapfonthorizoncache[i]);
- for i:=0 to 255 do
- if bitmapfontverticalcache[i]<>0 then
- DeleteObject(bitmapfontverticalcache[i]);
- for i:=0 to high(pens) do
- if pens[i]<>0 then
- DeleteObject(pens[i]);
- LeaveCriticalSection(graphdrawing);
- {$ifdef DEBUG_WM_PAINT}
- close(graphdebug);
- {$endif DEBUG_WM_PAINT}
- PostQuitMessage(0);
- Exit;
- end
- else
- WindowProcGraph := DefWindowProc(Window, AMessage, WParam, LParam);
- end;
- end;
- function WindowProcParent(Window: HWnd; AMessage:UInt; WParam : WParam;
- LParam: LParam): Longint; stdcall;
- begin
- WindowProcParent := 0;
- case AMessage of
- wm_keydown,
- wm_keyup,
- wm_char:
- begin
- if assigned(charmessagehandler) then
- WindowProcParent:=charmessagehandler(window,amessage,wparam,lparam);
- end;
- wm_notify:
- begin
- if assigned(notifymessagehandler) then
- WindowProcParent:=notifymessagehandler(window,amessage,wparam,lparam);
- end;
- wm_command:
- if assigned(commandmessagehandler) then
- WindowProcParent:=commandmessagehandler(window,amessage,wparam,lparam);
- else
- WindowProcParent := DefWindowProc(Window, AMessage, WParam, LParam);
- end;
- end;
- function WinRegister: Boolean;
- var
- WindowClass: WndClass;
- begin
- WindowClass.Style := graphwindowstyle;
- WindowClass.lpfnWndProc := WndProc(@WindowProcGraph);
- WindowClass.cbClsExtra := 0;
- WindowClass.cbWndExtra := 0;
- WindowClass.hInstance := system.MainInstance;
- if icon<>0 then
- WindowClass.hIcon := icon
- else
- WindowClass.hIcon := LoadIcon(0, idi_Application);
- WindowClass.hCursor := LoadCursor(0, idc_Arrow);
- WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
- if menu<>0 then
- WindowClass.lpszMenuName := MAKEINTRESOURCE(menu)
- else
- WindowClass.lpszMenuName := nil;
- WindowClass.lpszClassName := 'FPCGraphWindow';
- winregister:=RegisterClass(WindowClass) <> 0;
- end;
- function WinRegisterWithChild: Boolean;
- var
- WindowClass: WndClass;
- begin
- WindowClass.Style := graphwindowstyle;
- WindowClass.lpfnWndProc := WndProc(@WindowProcParent);
- WindowClass.cbClsExtra := 0;
- WindowClass.cbWndExtra := 0;
- WindowClass.hInstance := system.MainInstance;
- if icon<>0 then
- WindowClass.hIcon := icon
- else
- WindowClass.hIcon := LoadIcon(0, idi_Application);
- WindowClass.hCursor := LoadCursor(0, idc_Arrow);
- WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
- if menu<>0 then
- WindowClass.lpszMenuName := MAKEINTRESOURCE(menu)
- else
- WindowClass.lpszMenuName := nil;
- WindowClass.lpszClassName := 'FPCGraphWindowMain';
- WinRegisterWithChild:=RegisterClass(WindowClass) <> 0;
- {$ifdef DEBUGCHILDS}
- writeln('Main window successfully registered: WinRegisterWithChild is ',WinRegisterWithChild);
- {$endif DEBUGCHILDS}
- if WinRegisterWithChild then
- begin
- WindowClass.Style := CS_HREDRAW or CS_VREDRAW;
- WindowClass.lpfnWndProc := WndProc(@WindowProcGraph);
- WindowClass.cbClsExtra := 0;
- WindowClass.cbWndExtra := 0;
- WindowClass.hInstance := system.MainInstance;
- WindowClass.hIcon := 0;
- WindowClass.hCursor := LoadCursor(0, idc_Arrow);
- WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
- WindowClass.lpszMenuName := nil;
- WindowClass.lpszClassName := 'FPCGraphWindowChild';
- WinRegisterWithChild:=RegisterClass(WindowClass)<>0;
- {$ifdef DEBUGCHILDS}
- writeln('Child window registered: WinRegisterWithChild is ',WinRegisterWithChild);
- {$endif DEBUGCHILDS}
- end;
- end;
- var
- // here we can force the creation of a maximized window }
- extrastyle : cardinal;
- { Create the Window Class }
- function WinCreate : HWnd;
- var
- hWindow: HWnd;
- begin
- WinCreate:=0;
- if UseChildWindow then
- begin
- ParentWindow:=CreateWindow('FPCGraphWindowMain', windowtitle,
- WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or extrastyle, longint(CW_USEDEFAULT), 0,
- maxx+ChildOffset.Left+ChildOffset.Right+1+
- 2*GetSystemMetrics(SM_CXFRAME),
- maxy+ChildOffset.Top+ChildOffset.Bottom+1+
- 2*GetSystemMetrics(SM_CYFRAME)+
- GetSystemMetrics(SM_CYCAPTION),
- 0, 0, system.MainInstance, nil);
- if ParentWindow<>0 then
- begin
- ShowWindow(ParentWindow, SW_SHOW);
- UpdateWindow(ParentWindow);
- end
- else
- exit;
- hWindow:=CreateWindow('FPCGraphWindowChild',nil,
- WS_CHILD, ChildOffset.Left,ChildOffset.Top,
- maxx+1,maxy+1,
- ParentWindow, 0, system.MainInstance, nil);
- if hwindow<>0 then
- begin
- ShowWindow(hwindow, SW_SHOW);
- UpdateWindow(hwindow);
- end
- else
- exit;
- WinCreate:=hWindow;
- end
- else
- begin
- hWindow:=CreateWindow('FPCGraphWindow', windowtitle,
- ws_OverlappedWindow or extrastyle, longint(CW_USEDEFAULT), 0,
- maxx+1+2*GetSystemMetrics(SM_CXFRAME),
- maxy+1+2*GetSystemMetrics(SM_CYFRAME)+
- GetSystemMetrics(SM_CYCAPTION),
- 0, 0, system.MainInstance, nil);
- if hWindow <> 0 then
- begin
- ShowWindow(hWindow, SW_SHOW);
- UpdateWindow(hWindow);
- WinCreate:=hWindow;
- end;
- end;
- end;
- const
- winregistered : boolean = false;
- function MessageHandleThread(p : pointer) : DWord;StdCall;
- var
- AMessage: Msg;
- begin
- if not(winregistered) then
- begin
- if UseChildWindow then
- begin
- if not(WinRegisterWithChild) then
- begin
- MessageBox(0, 'Window registration failed', nil, mb_Ok);
- ExitThread(1);
- end;
- end
- else
- begin
- if not(WinRegister) then
- begin
- MessageBox(0, 'Window registration failed', nil, mb_Ok);
- ExitThread(1);
- end;
- end;
- GraphWindow:=WinCreate;
- winregistered:=true;
- end;
- if longint(GraphWindow) = 0 then begin
- MessageBox(0, 'Window creation failed', nil, mb_Ok);
- ExitThread(1);
- end;
- while longint(GetMessage(@AMessage, 0, 0, 0))=longint(true) do
- begin
- TranslateMessage(AMessage);
- DispatchMessage(AMessage);
- end;
- MessageHandleThread:=0;
- end;
- procedure InitWin32GUI16colors;
- var
- threadexitcode : longint;
- begin
- getmem(pal,sizeof(RGBrec)*maxcolor);
- move(DefaultColors,pal^,sizeof(RGBrec)*maxcolor);
- if (IntCurrentMode=mMaximizedWindow16) or
- (IntCurrentMode=mMaximizedWindow256) or
- (IntCurrentMode=mMaximizedWindow32k) or
- (IntCurrentMode=mMaximizedWindow64k) or
- (IntCurrentMode=mMaximizedWindow16M) then
- extrastyle:=ws_maximize
- else
- extrastyle:=0;
- { start graph subsystem }
- InitializeCriticalSection(graphdrawing);
- graphrunning:=false;
- MessageThreadHandle:=CreateThread(nil,0,@MessageHandleThread,
- nil,0,MessageThreadID);
- repeat
- GetExitCodeThread(MessageThreadHandle,@threadexitcode);
- until graphrunning or (threadexitcode<>STILL_ACTIVE);
- if threadexitcode<>STILL_ACTIVE then
- _graphresult := grerror;
- end;
- procedure CloseGraph;
- begin
- If not isgraphmode then
- begin
- _graphresult := grnoinitgraph;
- exit
- end;
- if UseChildWindow then
- begin
- { if the child window isn't destroyed }
- { the main window can't be closed }
- { I don't know any other way (FK) }
- PostMessage(GraphWindow,wm_destroy,0,0);
- PostMessage(ParentWindow,wm_destroy,0,0)
- end
- else
- PostMessage(GraphWindow,wm_destroy,0,0);
- PostThreadMessage(MessageThreadHandle,wm_quit,0,0);
- WaitForSingleObject(MessageThreadHandle,Infinite);
- CloseHandle(MessageThreadHandle);
- DeleteCriticalSection(graphdrawing);
- freemem(pal,sizeof(RGBrec)*maxcolor);
- end;
- procedure LineWin32GUI(X1, Y1, X2, Y2: smallint); {$ifndef fpc}far;{$endif fpc}
- var X, Y : smallint;
- deltax, deltay : smallint;
- d, dinc1, dinc2: smallint;
- xinc1 : smallint;
- xinc2 : smallint;
- yinc1 : smallint;
- yinc2 : smallint;
- i : smallint;
- Flag : Boolean; { determines pixel direction in thick lines }
- NumPixels : smallint;
- PixelCount : smallint;
- OldCurrentColor: Word;
- swtmp : smallint;
- TmpNumPixels : smallint;
- col : longint;
- pen,oldpen : hpen;
- begin
- if graphrunning then
- begin
- {******************************************}
- { SOLID LINES }
- {******************************************}
- if lineinfo.LineStyle = SolidLn then
- Begin
- { Convert to global coordinates. }
- x1 := x1 + StartXViewPort;
- x2 := x2 + StartXViewPort;
- y1 := y1 + StartYViewPort;
- y2 := y2 + StartYViewPort;
- { if fully clipped then exit... }
- if ClipPixels then
- begin
- if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
- StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
- exit;
- If LineInfo.Thickness=NormWidth then
- Begin
- EnterCriticalSection(graphdrawing);
- {
- if currentwritemode<>normalput then
- begin
- case currentwritemode of
- XORPut:
- begin
- SetROP2(windc,R2_XORPEN);
- SetROP2(bitmapdc,R2_XORPEN);
- end;
- AndPut:
- begin
- SetROP2(windc,R2_MASKPEN);
- SetROP2(bitmapdc,R2_MASKPEN);
- end;
- OrPut:
- begin
- SetROP2(windc,R2_MERGEPEN);
- SetROP2(bitmapdc,R2_MERGEPEN);
- end;
- end;
- end;
- }
- col:=RGB(pal[CurrentColor].red,pal[CurrentColor].green,pal[CurrentColor].blue);
- pen:=CreatePen(PS_SOLID,1,col);
- if pen=0 then
- writeln('Pen konnte nicht erzeugt werden!');
- oldpen:=SelectObject(windc,pen);
- MoveToEx(windc,x1,y1,nil);
- Windows.LineTo(windc,x2,y2);
- SetPixel(windc,x2,y2,col);
- SelectObject(windc,oldpen);
- oldpen:=SelectObject(bitmapdc,pen);
- MoveToEx(bitmapdc,x1,y1,nil);
- Windows.LineTo(bitmapdc,x2,y2);
- SetPixel(bitmapdc,x2,y2,col);
- SelectObject(bitmapdc,oldpen);
- DeleteObject(pen);
- {
- if currentwritemode<>normalput then
- begin
- SetROP2(windc,R2_COPYPEN);
- SetROP2(bitmapdc,R2_COPYPEN);
- end;
- }
- LeaveCriticalSection(graphdrawing);
- end
- else
- { Thick width lines }
- begin
- { Draw the pixels }
- for i := 1 to numpixels do
- begin
- { all depending on the slope, we can determine }
- { in what direction the extra width pixels will be put }
- If Flag then
- Begin
- DirectPutPixelClip(x-1,y);
- DirectPutPixelClip(x,y);
- DirectPutPixelClip(x+1,y);
- end
- else
- Begin
- DirectPutPixelClip(x, y-1);
- DirectPutPixelClip(x, y);
- DirectPutPixelClip(x, y+1);
- end;
- if d < 0 then
- begin
- d := d + dinc1;
- x := x + xinc1;
- y := y + yinc1;
- end
- else
- begin
- d := d + dinc2;
- x := x + xinc2;
- y := y + yinc2;
- end;
- end;
- end;
- end;
- end
- else
- {******************************************}
- { begin patterned lines }
- {******************************************}
- Begin
- { Convert to global coordinates. }
- x1 := x1 + StartXViewPort;
- x2 := x2 + StartXViewPort;
- y1 := y1 + StartYViewPort;
- y2 := y2 + StartYViewPort;
- { if fully clipped then exit... }
- if ClipPixels then
- begin
- if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
- StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
- exit;
- end;
- OldCurrentColor := CurrentColor;
- PixelCount:=0;
- if y1 = y2 then
- Begin
- { Check if we must swap }
- if x1 >= x2 then
- Begin
- swtmp := x1;
- x1 := x2;
- x2 := swtmp;
- end;
- if LineInfo.Thickness = NormWidth then
- Begin
- for PixelCount:=x1 to x2 do
- { optimization: PixelCount mod 16 }
- if LinePatterns[PixelCount and 15] = TRUE then
- begin
- DirectPutPixel(PixelCount,y2);
- end;
- end
- else
- Begin
- for i:=-1 to 1 do
- Begin
- for PixelCount:=x1 to x2 do
- { Optimization from Thomas - mod 16 = and 15 }
- {this optimization has been performed by the compiler
- for while as well (JM)}
- if LinePatterns[PixelCount and 15] = TRUE then
- begin
- DirectPutPixelClip(PixelCount,y2+i);
- end;
- end;
- end;
- end
- else
- if x1 = x2 then
- Begin
- { Check if we must swap }
- if y1 >= y2 then
- Begin
- swtmp := y1;
- y1 := y2;
- y2 := swtmp;
- end;
- if LineInfo.Thickness = NormWidth then
- Begin
- for PixelCount:=y1 to y2 do
- { compare if we should plot a pixel here , compare }
- { with predefined line patterns... }
- if LinePatterns[PixelCount and 15] = TRUE then
- begin
- DirectPutPixel(x1,PixelCount);
- end;
- end
- else
- Begin
- for i:=-1 to 1 do
- Begin
- for PixelCount:=y1 to y2 do
- { compare if we should plot a pixel here , compare }
- { with predefined line patterns... }
- if LinePatterns[PixelCount and 15] = TRUE then
- begin
- DirectPutPixelClip(x1+i,PixelCount);
- end;
- end;
- end;
- end
- else
- Begin
- oldCurrentColor := CurrentColor;
- { Calculate deltax and deltay for initialisation }
- deltax := abs(x2 - x1);
- deltay := abs(y2 - y1);
- { Initialize all vars based on which is the independent variable }
- if deltax >= deltay then
- begin
- Flag := FALSE;
- { x is independent variable }
- numpixels := deltax + 1;
- d := (2 * deltay) - deltax;
- dinc1 := deltay Shl 1;
- dinc2 := (deltay - deltax) shl 1;
- xinc1 := 1;
- xinc2 := 1;
- yinc1 := 0;
- yinc2 := 1;
- end
- else
- begin
- Flag := TRUE;
- { y is independent variable }
- numpixels := deltay + 1;
- d := (2 * deltax) - deltay;
- dinc1 := deltax Shl 1;
- dinc2 := (deltax - deltay) shl 1;
- xinc1 := 0;
- xinc2 := 1;
- yinc1 := 1;
- yinc2 := 1;
- end;
- { Make sure x and y move in the right directions }
- if x1 > x2 then
- begin
- xinc1 := - xinc1;
- xinc2 := - xinc2;
- end;
- if y1 > y2 then
- begin
- yinc1 := - yinc1;
- yinc2 := - yinc2;
- end;
- { Start drawing at <x1, y1> }
- x := x1;
- y := y1;
- If LineInfo.Thickness=ThickWidth then
- Begin
- TmpNumPixels := NumPixels-1;
- { Draw the pixels }
- for i := 0 to TmpNumPixels do
- begin
- { all depending on the slope, we can determine }
- { in what direction the extra width pixels will be put }
- If Flag then
- Begin
- { compare if we should plot a pixel here , compare }
- { with predefined line patterns... }
- if LinePatterns[i and 15] = TRUE then
- begin
- DirectPutPixelClip(x-1,y);
- DirectPutPixelClip(x,y);
- DirectPutPixelClip(x+1,y);
- end;
- end
- else
- Begin
- { compare if we should plot a pixel here , compare }
- { with predefined line patterns... }
- if LinePatterns[i and 15] = TRUE then
- begin
- DirectPutPixelClip(x,y-1);
- DirectPutPixelClip(x,y);
- DirectPutPixelClip(x,y+1);
- end;
- end;
- if d < 0 then
- begin
- d := d + dinc1;
- x := x + xinc1;
- y := y + yinc1;
- end
- else
- begin
- d := d + dinc2;
- x := x + xinc2;
- y := y + yinc2;
- end;
- end;
- end
- else
- Begin
- { instead of putting in loop , substract by one now }
- TmpNumPixels := NumPixels-1;
- { NormWidth }
- for i := 0 to TmpNumPixels do
- begin
- if LinePatterns[i and 15] = TRUE then
- begin
- DirectPutPixel(x,y);
- end;
- if d < 0 then
- begin
- d := d + dinc1;
- x := x + xinc1;
- y := y + yinc1;
- end
- else
- begin
- d := d + dinc2;
- x := x + xinc2;
- y := y + yinc2;
- end;
- end;
- end
- end;
- {******************************************}
- { end patterned lines }
- {******************************************}
- { restore color }
- CurrentColor:=OldCurrentColor;
- end;
- end;
- end; { Line }
- { multipage support could be done by using more than one background bitmap }
- procedure SetVisualWin32GUI(page: word);
- begin
- end;
- procedure SetActiveWin32GUI(page: word);
- begin
- end;
- function queryadapterinfo : pmodeinfo;
- var
- mode: TModeInfo;
- ScreenWidth,ScreenHeight : longint;
- ScreenWidthMaximized,ScreenHeightMaximized : longint;
- procedure SetupWin32GUIDefault;
- begin
- mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
- mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
- mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
- mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
- mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
- mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
- mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
- mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
- mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
- mode.OuttextXY:={$ifdef fpc}@{$endif}OuttextXYWin32GUI;
- mode.VLine := {$ifdef fpc}@{$endif}VLine16Win32GUI;
- // mode.circle := {$ifdef fpc}@{$endif}Circle16Win32GUI;
- // doesn't work yet
- // mode.Line:={$ifdef fpc}@{$endif}LineWin32GUI;
- end;
- begin
- SaveVideoState:={$ifdef fpc}@{$endif}savestate;
- RestoreVideoState:={$ifdef fpc}@{$endif}restorestate;
- { we must take care of the border and caption }
- ScreenWidth:=GetSystemMetrics(SM_CXSCREEN)-
- 2*GetSystemMetrics(SM_CXFRAME);
- ScreenHeight:=GetSystemMetrics(SM_CYSCREEN)-
- 2*GetSystemMetrics(SM_CYFRAME)-
- GetSystemMetrics(SM_CYCAPTION);
- { for maximozed windows it's again different }
- { here we've only a caption }
- ScreenWidthMaximized:=GetSystemMetrics(SM_CXFULLSCREEN);
- { neither GetSystemMetrics(SM_CYFULLSCREEN nor }
- { SystemParametersInfo(SPI_GETWORKAREA) }
- { takes a hidden try into account :( FK }
- ScreenHeightMaximized:=GetSystemMetrics(SM_CYFULLSCREEN);
- QueryAdapterInfo := ModeList;
- { If the mode listing already exists... }
- { simply return it, without changing }
- { anything... }
- if assigned(ModeList) then
- exit;
- { the first one becomes the standard mode }
- if (ScreenWidth>=640) and (ScreenHeight>=480) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VGA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=VGAHi;
- mode.ModeName:='640 x 480 x 16 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 479;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if (ScreenWidth>=640) and (ScreenHeight>=200) then
- begin
- InitMode(mode);
- { now add all standard VGA modes... }
- mode.DriverNumber:= VGA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=VGALo;
- mode.ModeName:='640 x 200 x 16 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 199;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if (ScreenWidth>=640) and (ScreenHeight>=350) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VGA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=VGAMed;
- mode.ModeName:='640 x 350 x 16 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 349;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if (ScreenWidth>=640) and (ScreenHeight>=400) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m640x400x256;
- mode.ModeName:='640 x 400 x 256 Win32GUI';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 399;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if (ScreenWidth>=640) and (ScreenHeight>=480) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m640x480x256;
- mode.ModeName:='640 x 480 x 256 Win32GUI';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 479;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- { add 800x600 only if screen is large enough }
- If (ScreenWidth>=800) and (ScreenHeight>=600) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m800x600x16;
- mode.ModeName:='800 x 600 x 16 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 799;
- mode.MaxY := 599;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m800x600x256;
- mode.ModeName:='800 x 600 x 256 Win32GUI';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 799;
- mode.MaxY := 599;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- { add 1024x768 only if screen is large enough }
- If (ScreenWidth>=1024) and (ScreenHeight>=768) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m1024x768x16;
- mode.ModeName:='1024 x 768 x 16 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 1023;
- mode.MaxY := 767;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m1024x768x256;
- mode.ModeName:='1024 x 768 x 256 Win32GUI';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 1023;
- mode.MaxY := 768;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- { add 1280x1024 only if screen is large enough }
- If (ScreenWidth>=1280) and (ScreenHeight>=1024) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m1280x1024x16;
- mode.ModeName:='1280 x 1024 x 16 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 1279;
- mode.MaxY := 1023;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m1280x1024x256;
- mode.ModeName:='1280 x 1024 x 256 Win32GUI';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 1279;
- mode.MaxY := 1023;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- { at least we add a mode with the largest possible window }
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=mLargestWindow16;
- mode.ModeName:='Largest Window x 16';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := ScreenWidth-1;
- mode.MaxY := ScreenHeight-1;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=mLargestWindow256;
- mode.ModeName:='Largest Window x 256';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := ScreenWidth-1;
- mode.MaxY := ScreenHeight-1;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- { .. and a maximized window }
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=mMaximizedWindow16;
- mode.ModeName:='Maximized Window x 16';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := ScreenWidthMaximized-1;
- mode.MaxY := ScreenHeightMaximized-1;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=mMaximizedWindow256;
- mode.ModeName:='Maximized Window x 256';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := ScreenWidthMaximized-1;
- mode.MaxY := ScreenHeightMaximized-1;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- begin
- InitializeGraph;
- charmessagehandler:=nil;
- mousemessagehandler:=nil;
- commandmessagehandler:=nil;
- notifymessagehandler:=nil;
- OnGraphWindowCreation:=nil;
- end.
- {
- $Log$
- Revision 1.12 2003-04-23 11:35:00 peter
- * wndproc definition fixed
- Revision 1.11 2003/04/23 11:08:09 florian
- * fixed parameter types
- Revision 1.10 2002/09/07 16:01:28 peter
- * old logs removed and tabs fixed
- Revision 1.9 2002/01/06 15:37:20 florian
- * log fixed
- Revision 1.8 2002/01/06 15:23:42 florian
- * SetRGBColor with cached pens fixed
- }
|